home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / backup.arc / BKPSAVF.CLP < prev    next >
Encoding:
Text File  |  1991-12-04  |  6.3 KB  |  80 lines
  1.         /*~  CRTCLPGM PGM(BKPSAVF.YOURLIB) SRCFILE(YOUSRC.YOURLIB) +            
  2. ~                         USRPRF(*OWNER) PUBAUT(*NORMAL)           ~*/          
  3.                                                                                 
  4.         /*~*******************************************************~*/           
  5.         /*~PROGRAM:  BKPSAVF.YOURLIB                              ~*/           
  6.         /*~DISCRIPTION: BACKUP SAVE FILES TO DISK OR TAPE         ~*/           
  7.         /*~                                                       ~*/           
  8.         /*~COMPILATION OPTIONS: CREATE DSPFD OUTFILE IN QTEMP     ~*/           
  9.         /*~  EXECUTE FOLLOWING COMMAND FROM COMMAND ENTRY SCREEN  ~*/           
  10.         /*~  DSPFD FILE(SA*.QGPL) TYPE(*BASATR) OUTPUT(*NONE) +   ~*/           
  11.         /*~               FILEATR(*SAV) OUTFILE(DSPFD.QTEMP)      ~*/           
  12.         /*~SWITCHES: NONE                                         ~*/           
  13.         /*~                                                       ~*/           
  14.         /*~WRITEN BY BRIAN GREWAL.                                ~*/           
  15.         /*~                                                       ~*/           
  16.         /*~I TAKE NO RESPONSIBILITY OF FUNCTION OF THIS CODE.     ~*/           
  17.         /*~COMPILE AND EXECUTE IT AT YOUR OWN RISK.               ~*/           
  18.         /*~                                                       ~*/           
  19.         /*~                                                       ~*/           
  20.         /*~                                                       ~*/           
  21.         /*~*******************************************************~*/           
  22.                                                                                 
  23.              PGM        PARM(&DEVICE)                                           
  24.                                                                                 
  25.              DCL        &DEVICE *CHAR 1                                         
  26.              DCL        &TYPE *CHAR 1                                           
  27.              DCL        &FULLDEV *CHAR 10                                       
  28.              DCL        &CMD *CHAR 1200                                         
  29.              DCL        VAR(&ATTR) TYPE(*CHAR) LEN(1) VALUE(X'2B')              
  30.              DCL        VAR(&NORMAL) TYPE(*CHAR) VALUE(X'20')                   
  31.              DCLF       DSPFD.QTEMP                                             
  32.                                                                                 
  33.              RTVJOBA    TYPE(&TYPE)                                             
  34.              CHGJOB     INQMSGRPY(*SYSRPYL) OUTQ(QSAVEOUTQ)                     
  35.              DSPOBJD    OBJ(SA*.QGPL) OBJTYPE(*FILE) OUTPUT(*LIST)              
  36.              MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(END))                   
  37.              DSPFD      FILE(SA*.QGPL) TYPE(*BASATR) OUTPUT(*NONE) +            
  38.                           FILEATR(*SAV) OUTFILE(DSPFD.QTEMP)                    
  39.              CLRDKT     LOC(*M1 1 *ONLY)                                        
  40.              IF         COND(&DEVICE = 'D') THEN(CHGVAR VAR(&FULLDEV) +         
  41.                           VALUE('Diskette'))                                    
  42.              ELSE       CMD(CHGVAR VAR(&FULLDEV) VALUE('Tape'))                 
  43.  READ:       RCVF                                                               
  44.              MONMSG     CPF0864 EXEC(GOTO EOF)                                  
  45.              DSPSAVF    FILE(&ATFILE.QGPL) OUTPUT(*LIST)                        
  46.              IF         COND(&TYPE = '1') THEN(SNDPGMMSG +                      
  47.                           MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +                   
  48.                           MSGDTA('Saving data from' *TCAT &ATTR *TCAT +         
  49.                           &ATFILE *TCAT &NORMAL *TCAT 'savefile to' +           
  50.                           *BCAT &FULLDEV) TOPGMQ(*EXT) +                        
  51.                           MSGTYPE(*STATUS))                                     
  52.     /*~  SAVE TO DISKETTE  ~*/                                                  
  53.              IF         (&DEVICE *EQ 'D') DO                                    
  54.              CHGVAR     VAR(&CMD) VALUE('SAVSAVFDTA SAVF(' *TCAT +              
  55.                           &ATFILE *TCAT '.QGPL) LOC(*M12 *SEARCH) +             
  56.                           CLEAR(*YES)')                                         
  57.              CALL       QCAEXEC (&CMD 1200)                                     
  58.              MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(READ))                  
  59.              DLTF       &ATFILE.QGPL                                            
  60.              GOTO       READ                                                    
  61.              ENDDO      /*~ DEVICE IFEQ 'D' ~*/                                 
  62.                                                                                 
  63.     /*~  SAVE TO TAPE      ~*/                                                  
  64.                                                                                 
  65.              IF         (&DEVICE *EQ 'T') DO                                    
  66.              CHGVAR     VAR(&CMD) VALUE('SAVSAVFDTA SAVF(' *TCAT +              
  67.                           &ATFILE *TCAT '.QGPL) DEV(QTAPE) +                    
  68.                           ENDOPT(*LEAVE) CLEAR(*YES)')                          
  69.              CALL       QCAEXEC (&CMD 1200)                                     
  70.              MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(READ))                  
  71.              DLTF       &ATFILE.QGPL                                            
  72.              GOTO       READ                                                    
  73.              ENDDO      /*~ DEVICE IFEQ 'T' ~*/                                 
  74.              GOTO       READ                                                    
  75.  EOF:        DSPOBJD    OBJ(SA*.QGPL) OBJTYPE(*FILE) OUTPUT(*LIST)              
  76.              MONMSG    CPF0000                                                  
  77.              SNDPGMMSG  MSGID(CPI9801) MSGF(QCPFMSG.QSYS) +                     
  78.                           TOPGMQ(*EXT) MSGTYPE(*STATUS)                         
  79.  END:        ENDPGM                                                             
  80.